home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / entry.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  16.6 KB  |  667 lines
  1. # entry.tcl --
  2. #
  3. # This file defines the default bindings for Tk entry widgets and provides
  4. # procedures that help in implementing those bindings.
  5. #
  6. # RCS: @(#) $Id: entry.tcl,v 1.26 2007/12/13 15:26:27 dgp Exp $
  7. #
  8. # Copyright (c) 1992-1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1997 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # Elements of tk::Priv that are used in this file:
  17. #
  18. # afterId -        If non-null, it means that auto-scanning is underway
  19. #            and it gives the "after" id for the next auto-scan
  20. #            command to be executed.
  21. # mouseMoved -        Non-zero means the mouse has moved a significant
  22. #            amount since the button went down (so, for example,
  23. #            start dragging out a selection).
  24. # pressX -        X-coordinate at which the mouse button was pressed.
  25. # selectMode -        The style of selection currently underway:
  26. #            char, word, or line.
  27. # x, y -        Last known mouse coordinates for scanning
  28. #            and auto-scanning.
  29. # data -        Used for Cut and Copy
  30. #-------------------------------------------------------------------------
  31.  
  32. #-------------------------------------------------------------------------
  33. # The code below creates the default class bindings for entries.
  34. #-------------------------------------------------------------------------
  35. bind Entry <<Cut>> {
  36.     if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  37.     clipboard clear -displayof %W
  38.     clipboard append -displayof %W $tk::Priv(data)
  39.     %W delete sel.first sel.last
  40.     unset tk::Priv(data)
  41.     }
  42. }
  43. bind Entry <<Copy>> {
  44.     if {![catch {tk::EntryGetSelection %W} tk::Priv(data)]} {
  45.     clipboard clear -displayof %W
  46.     clipboard append -displayof %W $tk::Priv(data)
  47.     unset tk::Priv(data)
  48.     }
  49. }
  50. bind Entry <<Paste>> {
  51.     global tcl_platform
  52.     catch {
  53.     if {[tk windowingsystem] ne "x11"} {
  54.         catch {
  55.         %W delete sel.first sel.last
  56.         }
  57.     }
  58.     %W insert insert [::tk::GetSelection %W CLIPBOARD]
  59.     tk::EntrySeeInsert %W
  60.     }
  61. }
  62. bind Entry <<Clear>> {
  63.     # ignore if there is no selection
  64.     catch { %W delete sel.first sel.last }
  65. }
  66. bind Entry <<PasteSelection>> {
  67.     if {$tk_strictMotif || ![info exists tk::Priv(mouseMoved)]
  68.     || !$tk::Priv(mouseMoved)} {
  69.     tk::EntryPaste %W %x
  70.     }
  71. }
  72.  
  73. bind Entry <<TraverseIn>> {
  74.     %W selection range 0 end 
  75.     %W icursor end 
  76. }
  77.  
  78. # Standard Motif bindings:
  79.  
  80. bind Entry <1> {
  81.     tk::EntryButton1 %W %x
  82.     %W selection clear
  83. }
  84. bind Entry <B1-Motion> {
  85.     set tk::Priv(x) %x
  86.     tk::EntryMouseSelect %W %x
  87. }
  88. bind Entry <Double-1> {
  89.     set tk::Priv(selectMode) word
  90.     tk::EntryMouseSelect %W %x
  91.     catch {%W icursor sel.last}
  92. }
  93. bind Entry <Triple-1> {
  94.     set tk::Priv(selectMode) line
  95.     tk::EntryMouseSelect %W %x
  96.     catch {%W icursor sel.last}
  97. }
  98. bind Entry <Shift-1> {
  99.     set tk::Priv(selectMode) char
  100.     %W selection adjust @%x
  101. }
  102. bind Entry <Double-Shift-1>    {
  103.     set tk::Priv(selectMode) word
  104.     tk::EntryMouseSelect %W %x
  105. }
  106. bind Entry <Triple-Shift-1>    {
  107.     set tk::Priv(selectMode) line
  108.     tk::EntryMouseSelect %W %x
  109. }
  110. bind Entry <B1-Leave> {
  111.     set tk::Priv(x) %x
  112.     tk::EntryAutoScan %W
  113. }
  114. bind Entry <B1-Enter> {
  115.     tk::CancelRepeat
  116. }
  117. bind Entry <ButtonRelease-1> {
  118.     tk::CancelRepeat
  119. }
  120. bind Entry <Control-1> {
  121.     %W icursor @%x
  122. }
  123.  
  124. bind Entry <Left> {
  125.     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  126. }
  127. bind Entry <Right> {
  128.     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  129. }
  130. bind Entry <Shift-Left> {
  131.     tk::EntryKeySelect %W [expr {[%W index insert] - 1}]
  132.     tk::EntrySeeInsert %W
  133. }
  134. bind Entry <Shift-Right> {
  135.     tk::EntryKeySelect %W [expr {[%W index insert] + 1}]
  136.     tk::EntrySeeInsert %W
  137. }
  138. bind Entry <Control-Left> {
  139.     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  140. }
  141. bind Entry <Control-Right> {
  142.     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  143. }
  144. bind Entry <Shift-Control-Left> {
  145.     tk::EntryKeySelect %W [tk::EntryPreviousWord %W insert]
  146.     tk::EntrySeeInsert %W
  147. }
  148. bind Entry <Shift-Control-Right> {
  149.     tk::EntryKeySelect %W [tk::EntryNextWord %W insert]
  150.     tk::EntrySeeInsert %W
  151. }
  152. bind Entry <Home> {
  153.     tk::EntrySetCursor %W 0
  154. }
  155. bind Entry <Shift-Home> {
  156.     tk::EntryKeySelect %W 0
  157.     tk::EntrySeeInsert %W
  158. }
  159. bind Entry <End> {
  160.     tk::EntrySetCursor %W end
  161. }
  162. bind Entry <Shift-End> {
  163.     tk::EntryKeySelect %W end
  164.     tk::EntrySeeInsert %W
  165. }
  166.  
  167. bind Entry <Delete> {
  168.     if {[%W selection present]} {
  169.     %W delete sel.first sel.last
  170.     } else {
  171.     %W delete insert
  172.     }
  173. }
  174. bind Entry <BackSpace> {
  175.     tk::EntryBackspace %W
  176. }
  177.  
  178. bind Entry <Control-space> {
  179.     %W selection from insert
  180. }
  181. bind Entry <Select> {
  182.     %W selection from insert
  183. }
  184. bind Entry <Control-Shift-space> {
  185.     %W selection adjust insert
  186. }
  187. bind Entry <Shift-Select> {
  188.     %W selection adjust insert
  189. }
  190. bind Entry <Control-slash> {
  191.     %W selection range 0 end
  192. }
  193. bind Entry <Control-backslash> {
  194.     %W selection clear
  195. }
  196. bind Entry <KeyPress> {
  197.     tk::CancelRepeat
  198.     tk::EntryInsert %W %A
  199. }
  200.  
  201. # Ignore all Alt, Meta, and Control keypresses unless explicitly bound.
  202. # Otherwise, if a widget binding for one of these is defined, the
  203. # <KeyPress> class binding will also fire and insert the character,
  204. # which is wrong.  Ditto for Escape, Return, and Tab.
  205.  
  206. bind Entry <Alt-KeyPress> {# nothing}
  207. bind Entry <Meta-KeyPress> {# nothing}
  208. bind Entry <Control-KeyPress> {# nothing}
  209. bind Entry <Escape> {# nothing}
  210. bind Entry <Return> {# nothing}
  211. bind Entry <KP_Enter> {# nothing}
  212. bind Entry <Tab> {# nothing}
  213. if {[tk windowingsystem] eq "aqua"} {
  214.     bind Entry <Command-KeyPress> {# nothing}
  215. }
  216.  
  217. # On Windows, paste is done using Shift-Insert.  Shift-Insert already
  218. # generates the <<Paste>> event, so we don't need to do anything here.
  219. if {$tcl_platform(platform) ne "windows"} {
  220.     bind Entry <Insert> {
  221.     catch {tk::EntryInsert %W [::tk::GetSelection %W PRIMARY]}
  222.     }
  223. }
  224.  
  225. # Additional emacs-like bindings:
  226.  
  227. bind Entry <Control-a> {
  228.     if {!$tk_strictMotif} {
  229.     tk::EntrySetCursor %W 0
  230.     }
  231. }
  232. bind Entry <Control-b> {
  233.     if {!$tk_strictMotif} {
  234.     tk::EntrySetCursor %W [expr {[%W index insert] - 1}]
  235.     }
  236. }
  237. bind Entry <Control-d> {
  238.     if {!$tk_strictMotif} {
  239.     %W delete insert
  240.     }
  241. }
  242. bind Entry <Control-e> {
  243.     if {!$tk_strictMotif} {
  244.     tk::EntrySetCursor %W end
  245.     }
  246. }
  247. bind Entry <Control-f> {
  248.     if {!$tk_strictMotif} {
  249.     tk::EntrySetCursor %W [expr {[%W index insert] + 1}]
  250.     }
  251. }
  252. bind Entry <Control-h> {
  253.     if {!$tk_strictMotif} {
  254.     tk::EntryBackspace %W
  255.     }
  256. }
  257. bind Entry <Control-k> {
  258.     if {!$tk_strictMotif} {
  259.     %W delete insert end
  260.     }
  261. }
  262. bind Entry <Control-t> {
  263.     if {!$tk_strictMotif} {
  264.     tk::EntryTranspose %W
  265.     }
  266. }
  267. bind Entry <Meta-b> {
  268.     if {!$tk_strictMotif} {
  269.     tk::EntrySetCursor %W [tk::EntryPreviousWord %W insert]
  270.     }
  271. }
  272. bind Entry <Meta-d> {
  273.     if {!$tk_strictMotif} {
  274.     %W delete insert [tk::EntryNextWord %W insert]
  275.     }
  276. }
  277. bind Entry <Meta-f> {
  278.     if {!$tk_strictMotif} {
  279.     tk::EntrySetCursor %W [tk::EntryNextWord %W insert]
  280.     }
  281. }
  282. bind Entry <Meta-BackSpace> {
  283.     if {!$tk_strictMotif} {
  284.     %W delete [tk::EntryPreviousWord %W insert] insert
  285.     }
  286. }
  287. bind Entry <Meta-Delete> {
  288.     if {!$tk_strictMotif} {
  289.     %W delete [tk::EntryPreviousWord %W insert] insert
  290.     }
  291. }
  292.  
  293. # A few additional bindings of my own.
  294.  
  295. bind Entry <2> {
  296.     if {!$tk_strictMotif} {
  297.     ::tk::EntryScanMark %W %x
  298.     }
  299. }
  300. bind Entry <B2-Motion> {
  301.     if {!$tk_strictMotif} {
  302.     ::tk::EntryScanDrag %W %x
  303.     }
  304. }
  305.  
  306. # ::tk::EntryClosestGap --
  307. # Given x and y coordinates, this procedure finds the closest boundary
  308. # between characters to the given coordinates and returns the index
  309. # of the character just after the boundary.
  310. #
  311. # Arguments:
  312. # w -        The entry window.
  313. # x -        X-coordinate within the window.
  314.  
  315. proc ::tk::EntryClosestGap {w x} {
  316.     set pos [$w index @$x]
  317.     set bbox [$w bbox $pos]
  318.     if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
  319.     return $pos
  320.     }
  321.     incr pos
  322. }
  323.  
  324. # ::tk::EntryButton1 --
  325. # This procedure is invoked to handle button-1 presses in entry
  326. # widgets.  It moves the insertion cursor, sets the selection anchor,
  327. # and claims the input focus.
  328. #
  329. # Arguments:
  330. # w -        The entry window in which the button was pressed.
  331. # x -        The x-coordinate of the button press.
  332.  
  333. proc ::tk::EntryButton1 {w x} {
  334.     variable ::tk::Priv
  335.  
  336.     set Priv(selectMode) char
  337.     set Priv(mouseMoved) 0
  338.     set Priv(pressX) $x
  339.     $w icursor [EntryClosestGap $w $x]
  340.     $w selection from insert
  341.     if {"disabled" ne [$w cget -state]} {
  342.     focus $w
  343.     }
  344. }
  345.  
  346. # ::tk::EntryMouseSelect --
  347. # This procedure is invoked when dragging out a selection with
  348. # the mouse.  Depending on the selection mode (character, word,
  349. # line) it selects in different-sized units.  This procedure
  350. # ignores mouse motions initially until the mouse has moved from
  351. # one character to another or until there have been multiple clicks.
  352. #
  353. # Arguments:
  354. # w -        The entry window in which the button was pressed.
  355. # x -        The x-coordinate of the mouse.
  356.  
  357. proc ::tk::EntryMouseSelect {w x} {
  358.     variable ::tk::Priv
  359.  
  360.     set cur [EntryClosestGap $w $x]
  361.     set anchor [$w index anchor]
  362.     if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  363.     set Priv(mouseMoved) 1
  364.     }
  365.     switch $Priv(selectMode) {
  366.     char {
  367.         if {$Priv(mouseMoved)} {
  368.         if {$cur < $anchor} {
  369.             $w selection range $cur $anchor
  370.         } elseif {$cur > $anchor} {
  371.             $w selection range $anchor $cur
  372.         } else {
  373.             $w selection clear
  374.         }
  375.         }
  376.     }
  377.     word {
  378.         if {$cur < [$w index anchor]} {
  379.         set before [tcl_wordBreakBefore [$w get] $cur]
  380.         set after [tcl_wordBreakAfter [$w get] [expr {$anchor-1}]]
  381.         } else {
  382.         set before [tcl_wordBreakBefore [$w get] $anchor]
  383.         set after [tcl_wordBreakAfter [$w get] [expr {$cur - 1}]]
  384.         }
  385.         if {$before < 0} {
  386.         set before 0
  387.         }
  388.         if {$after < 0} {
  389.         set after end
  390.         }
  391.         $w selection range $before $after
  392.     }
  393.     line {
  394.         $w selection range 0 end
  395.     }
  396.     }
  397.     if {$Priv(mouseMoved)} {
  398.         $w icursor $cur
  399.     }
  400.     update idletasks
  401. }
  402.  
  403. # ::tk::EntryPaste --
  404. # This procedure sets the insertion cursor to the current mouse position,
  405. # pastes the selection there, and sets the focus to the window.
  406. #
  407. # Arguments:
  408. # w -        The entry window.
  409. # x -        X position of the mouse.
  410.  
  411. proc ::tk::EntryPaste {w x} {
  412.     $w icursor [EntryClosestGap $w $x]
  413.     catch {$w insert insert [::tk::GetSelection $w PRIMARY]}
  414.     if {"disabled" ne [$w cget -state]} {
  415.     focus $w
  416.     }
  417. }
  418.  
  419. # ::tk::EntryAutoScan --
  420. # This procedure is invoked when the mouse leaves an entry window
  421. # with button 1 down.  It scrolls the window left or right,
  422. # depending on where the mouse is, and reschedules itself as an
  423. # "after" command so that the window continues to scroll until the
  424. # mouse moves back into the window or the mouse button is released.
  425. #
  426. # Arguments:
  427. # w -        The entry window.
  428.  
  429. proc ::tk::EntryAutoScan {w} {
  430.     variable ::tk::Priv
  431.     set x $Priv(x)
  432.     if {![winfo exists $w]} {
  433.     return
  434.     }
  435.     if {$x >= [winfo width $w]} {
  436.     $w xview scroll 2 units
  437.     EntryMouseSelect $w $x
  438.     } elseif {$x < 0} {
  439.     $w xview scroll -2 units
  440.     EntryMouseSelect $w $x
  441.     }
  442.     set Priv(afterId) [after 50 [list tk::EntryAutoScan $w]]
  443. }
  444.  
  445. # ::tk::EntryKeySelect --
  446. # This procedure is invoked when stroking out selections using the
  447. # keyboard.  It moves the cursor to a new position, then extends
  448. # the selection to that position.
  449. #
  450. # Arguments:
  451. # w -        The entry window.
  452. # new -        A new position for the insertion cursor (the cursor hasn't
  453. #        actually been moved to this position yet).
  454.  
  455. proc ::tk::EntryKeySelect {w new} {
  456.     if {![$w selection present]} {
  457.     $w selection from insert
  458.     $w selection to $new
  459.     } else {
  460.     $w selection adjust $new
  461.     }
  462.     $w icursor $new
  463. }
  464.  
  465. # ::tk::EntryInsert --
  466. # Insert a string into an entry at the point of the insertion cursor.
  467. # If there is a selection in the entry, and it covers the point of the
  468. # insertion cursor, then delete the selection before inserting.
  469. #
  470. # Arguments:
  471. # w -        The entry window in which to insert the string
  472. # s -        The string to insert (usually just a single character)
  473.  
  474. proc ::tk::EntryInsert {w s} {
  475.     if {$s eq ""} {
  476.     return
  477.     }
  478.     catch {
  479.     set insert [$w index insert]
  480.     if {([$w index sel.first] <= $insert)
  481.         && ([$w index sel.last] >= $insert)} {
  482.         $w delete sel.first sel.last
  483.     }
  484.     }
  485.     $w insert insert $s
  486.     EntrySeeInsert $w
  487. }
  488.  
  489. # ::tk::EntryBackspace --
  490. # Backspace over the character just before the insertion cursor.
  491. # If backspacing would move the cursor off the left edge of the
  492. # window, reposition the cursor at about the middle of the window.
  493. #
  494. # Arguments:
  495. # w -        The entry window in which to backspace.
  496.  
  497. proc ::tk::EntryBackspace w {
  498.     if {[$w selection present]} {
  499.     $w delete sel.first sel.last
  500.     } else {
  501.     set x [expr {[$w index insert] - 1}]
  502.     if {$x >= 0} {
  503.         $w delete $x
  504.     }
  505.     if {[$w index @0] >= [$w index insert]} {
  506.         set range [$w xview]
  507.         set left [lindex $range 0]
  508.         set right [lindex $range 1]
  509.         $w xview moveto [expr {$left - ($right - $left)/2.0}]
  510.     }
  511.     }
  512. }
  513.  
  514. # ::tk::EntrySeeInsert --
  515. # Make sure that the insertion cursor is visible in the entry window.
  516. # If not, adjust the view so that it is.
  517. #
  518. # Arguments:
  519. # w -        The entry window.
  520.  
  521. proc ::tk::EntrySeeInsert w {
  522.     set c [$w index insert]
  523.     if {($c < [$w index @0]) || ($c > [$w index @[winfo width $w]])} {
  524.     $w xview $c
  525.     }
  526. }
  527.  
  528. # ::tk::EntrySetCursor -
  529. # Move the insertion cursor to a given position in an entry.  Also
  530. # clears the selection, if there is one in the entry, and makes sure
  531. # that the insertion cursor is visible.
  532. #
  533. # Arguments:
  534. # w -        The entry window.
  535. # pos -        The desired new position for the cursor in the window.
  536.  
  537. proc ::tk::EntrySetCursor {w pos} {
  538.     $w icursor $pos
  539.     $w selection clear
  540.     EntrySeeInsert $w
  541. }
  542.  
  543. # ::tk::EntryTranspose -
  544. # This procedure implements the "transpose" function for entry widgets.
  545. # It tranposes the characters on either side of the insertion cursor,
  546. # unless the cursor is at the end of the line.  In this case it
  547. # transposes the two characters to the left of the cursor.  In either
  548. # case, the cursor ends up to the right of the transposed characters.
  549. #
  550. # Arguments:
  551. # w -        The entry window.
  552.  
  553. proc ::tk::EntryTranspose w {
  554.     set i [$w index insert]
  555.     if {$i < [$w index end]} {
  556.     incr i
  557.     }
  558.     set first [expr {$i-2}]
  559.     if {$first < 0} {
  560.     return
  561.     }
  562.     set data [$w get]
  563.     set new [string index $data [expr {$i-1}]][string index $data $first]
  564.     $w delete $first $i
  565.     $w insert insert $new
  566.     EntrySeeInsert $w
  567. }
  568.  
  569. # ::tk::EntryNextWord --
  570. # Returns the index of the next word position after a given position in the
  571. # entry.  The next word is platform dependent and may be either the next
  572. # end-of-word position or the next start-of-word position after the next
  573. # end-of-word position.
  574. #
  575. # Arguments:
  576. # w -        The entry window in which the cursor is to move.
  577. # start -    Position at which to start search.
  578.  
  579. if {$tcl_platform(platform) eq "windows"}  {
  580.     proc ::tk::EntryNextWord {w start} {
  581.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  582.     if {$pos >= 0} {
  583.         set pos [tcl_startOfNextWord [$w get] $pos]
  584.     }
  585.     if {$pos < 0} {
  586.         return end
  587.     }
  588.     return $pos
  589.     }
  590. } else {
  591.     proc ::tk::EntryNextWord {w start} {
  592.     set pos [tcl_endOfWord [$w get] [$w index $start]]
  593.     if {$pos < 0} {
  594.         return end
  595.     }
  596.     return $pos
  597.     }
  598. }
  599.  
  600. # ::tk::EntryPreviousWord --
  601. #
  602. # Returns the index of the previous word position before a given
  603. # position in the entry.
  604. #
  605. # Arguments:
  606. # w -        The entry window in which the cursor is to move.
  607. # start -    Position at which to start search.
  608.  
  609. proc ::tk::EntryPreviousWord {w start} {
  610.     set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
  611.     if {$pos < 0} {
  612.     return 0
  613.     }
  614.     return $pos
  615. }
  616.  
  617. # ::tk::EntryScanMark --
  618. #
  619. # Marks the start of a possible scan drag operation
  620. #
  621. # Arguments:
  622. # w -    The entry window from which the text to get
  623. # x -    x location on screen
  624.  
  625. proc ::tk::EntryScanMark {w x} {
  626.     $w scan mark $x
  627.     set ::tk::Priv(x) $x
  628.     set ::tk::Priv(y) 0 ; # not used
  629.     set ::tk::Priv(mouseMoved) 0
  630. }
  631.  
  632. # ::tk::EntryScanDrag --
  633. #
  634. # Marks the start of a possible scan drag operation
  635. #
  636. # Arguments:
  637. # w -    The entry window from which the text to get
  638. # x -    x location on screen
  639.  
  640. proc ::tk::EntryScanDrag {w x} {
  641.     # Make sure these exist, as some weird situations can trigger the
  642.     # motion binding without the initial press.  [Bug #220269]
  643.     if {![info exists ::tk::Priv(x)]} { set ::tk::Priv(x) $x }
  644.     # allow for a delta
  645.     if {abs($x-$::tk::Priv(x)) > 2} {
  646.     set ::tk::Priv(mouseMoved) 1
  647.     }
  648.     $w scan dragto $x
  649. }
  650.  
  651. # ::tk::EntryGetSelection --
  652. #
  653. # Returns the selected text of the entry with respect to the -show option.
  654. #
  655. # Arguments:
  656. # w -         The entry window from which the text to get
  657.  
  658. proc ::tk::EntryGetSelection {w} {
  659.     set entryString [string range [$w get] [$w index sel.first] \
  660.         [expr {[$w index sel.last] - 1}]]
  661.     if {[$w cget -show] ne ""} {
  662.     return [string repeat [string index [$w cget -show] 0] \
  663.         [string length $entryString]]
  664.     }
  665.     return $entryString
  666. }
  667.